home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
UserCode
/
sortLines.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
2KB
|
101 lines
# FILE: sortLines.tcl
#
# LAST UPDATE: 1/26/93 4:53:48 PM
#
# This version of sortLines has the option of ignoring blanks/whitespace (-b)
# and case-insensitive sorting (-i), or reverse sorting:
# sortLines [-b] [-i] [-r]
# COPYRIGHT:
#
# Copyright © 1992,1993 by David C. Black All rights reserved.
# Portions copyright © 1990, 1991, 1992 Pete Keleher. All Rights Reserved.
#
# Redistribution and use in source and binary forms are permitted
# provided that the above copyright notice and this paragraph are
# duplicated in all such forms and that any documentation,
# advertising materials, and other materials related to such
# distribution and use acknowledge that the software was developed
# by David C. Black.
#
# THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
################################################################################
# AUTHOR
#
# David C. Black
# GEnie: D.C.Black
# Internet: black@mpd.tandem.com (preferred)
# USnail: 6217 John Chisum Lane, Austin, TX 78749
#
################################################################################
proc reverseSort {} {sortLines -r}
proc sortLines {args} {
set b_flag [lsearch $args "-b"]
if {$b_flag != -1} {
set args [lreplace $args $b_flag $b_flag]
}
incr b_flag
set i_flag [lsearch $args "-i"]
if {$i_flag != -1} {
set args [lreplace $args $i_flag $i_flag]
}
incr i_flag
if {[lsearch $args "-r"] >= 0} {
set mode "-decreas"
} else {
set mode "-increas"
}
set start [getPos]
set end [selEnd]
if {$start == $end} {
alertnote "You must highlight the section you wish to sort."
return
}
if {[lookAt [expr $end-1]] != "\r"} {
alertnote "The selection must consist only of complete lines."
return
}
set text [split [getText $start [expr {$end-1}]] "\r"]
if {$b_flag > 0 || $i_flag > 0} {
foreach line $text {
if {$i_flag > 0} {
set key [string tolower $line]
} else {
set key $line
}
if {$b_flag > 0} {
regsub -all "\[ \t\]+" $key " " key
}
set orig($key) $line
lappend list $key
}
#endforeach
unset text
foreach key [lsort $mode $list] {
lappend text $orig($key)
}
#endforeach
} else {
set text [lsort $mode $text]
}
set text [join $text "\r"]
replaceText $start [expr {$end-1}] $text
select $start $end
}
# Test case:
#
# a black
# a black cat
# A black dog